home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 27.zip / BS1 part 27 / RS_DemoMakerD1.adf / VFTest.bas (.txt) < prev    next >
AmigaBASIC Source Code  |  1991-11-15  |  5KB  |  123 lines
  1. REM ***************** TESTPROGRAMM FÜR VEKTORFONHANDLER  *******************
  2.  
  3. CLEAR
  4.  
  5. ' -------- Libraryfunktionen einbinden -----------
  6. DECLARE FUNCTION FindTask& LIBRARY
  7. DECLARE FUNCTION FindPort& LIBRARY
  8. DECLARE FUNCTION GetMsg& LIBRARY
  9. DECLARE FUNCTION AllocMem& LIBRARY
  10. LIBRARY "exec.library"
  11. DECLARE FUNCTION xOpen& LIBRARY
  12. DECLARE FUNCTION xRead& LIBRARY
  13. LIBRARY "dos.library"
  14.  
  15. FileName$="df0:VektorFonts/topaz.vek"  : ' Vektorfontfile
  16. OutText$="Beispieltext"                : ' Ausgabetext
  17. ErrVar&=0                              : ' Fehlervariable
  18.  
  19. WINDOW 2,"Window",(0,0)-(617,180),15   : ' Ausgabefenster oeffnen
  20.  
  21. CALL LoadVekFont (FileName$)           : ' Vektorfont laden
  22.  
  23. IF VFontAdr&=0 THEN                   
  24.   PRINT "Nicht genuegend Speicher !"   : ' AllocMem erfolgreich ?
  25. END IF  
  26. h1%=PEEKW(VFontAdr&+4)                 : ' Kennung pruefen
  27. IF (h1% <> &Habcd) THEN
  28.   PRINT "Das ist kein Vektorfontfile !"
  29.   GOTO abbruch
  30. END IF
  31. IF MePort&=0 THEN          
  32.   PRINT "Handler wurde nicht gefunden !"
  33.   GOTO abbruch
  34.   END
  35. END IF
  36.  
  37. CALL VektorTextOut(10,10,50,50,2,OutText$,0)
  38. CALL VektorTextOut(10,60,100,100,4,OutText$,1)
  39.  
  40. abbruch:
  41.  
  42. IF VFontAdr& <> 0 THEN CALL FreeMem(VFontAdr&,VFontLen&)        
  43. IF VMessAdr& <> 0 THEN CALL FreeMem(VMessAdr&,64)             
  44. END
  45.  
  46. ' ********************* Subroutine Vektorfont laden **********************
  47.  
  48. SUB LoadVekFont (finame$) STATIC
  49. SHARED VFontLen&,VFontAdr&,VMessAdr&,Port1$,Port2$,RePort&,MePort&
  50.  
  51.   Port1$="vekfport-t0"+CHR$(0)             : ' Portname Messageport
  52.   Port2$="vekfport-t1"+CHR$(0)             : ' Portname ReplyPort
  53.   RePort&=0                                : ' ReplyPort Adresse
  54.   MePort&=0                                : ' MessagePort Adresse
  55.   VMessAdr&=0                              : ' Adresse von struct VFontMess
  56.   VFontLen&=0                              : ' Laenge Fontfile
  57.   VFontAdr&=0                              : ' Startadresse Fontfile
  58.  
  59.   OPEN finame$ FOR INPUT AS 1              : ' Filelaenge feststellen
  60.   VFontLen&=LOF(1)
  61.   CLOSE #1
  62.   VFontAdr&=AllocMem&(VFontLen&,0)        : ' Speicher fuer Font belegen
  63.   IF VFontAdr&=0 THEN EXIT SUB             : ' Nicht genuegend Speicher ?
  64.   a$=finame$+CHR$(0)                       : ' Filename terminieren
  65.   datei&=xOpen&(SADD(a$),1005)            : ' Datei oeffnen
  66.   IF datei&=0 THEN                            
  67.     PRINT "Datei nicht gefunden !"         : ' 0 - wenn Fehler
  68.   ELSE                                        
  69.     h&=xRead&(datei&,VFontAdr&,VFontLen&)  : ' datei in Speicher laden
  70.     xClose(datei&)                         : ' datei schliessen
  71.     CALL InitPorts                         : ' Messageports installieren
  72.   END IF  
  73.  
  74. END SUB
  75.  
  76. ' *************** Messageports von Handler Task suchen ********************
  77.   
  78. SUB InitPorts STATIC
  79. SHARED RePort&,MePort&,Port1$,Port2$,VMessAdr&,VFontAdr&
  80.  
  81.   MePort&=FindPort&(SADD(Port1$)) : ' Messageport von Handler suchen
  82.   RePort&=FindPort&(SADD(Port2$)) : ' Replyport suchen
  83.   IF MePort& <> 0 THEN
  84.     h1&=FindTask&(0)             : ' Zeiger auf eigenen Task suchen
  85.     POKEL RePort&+16,h1&          : ' ReplyPort auf eigenen Task setzen
  86.     POKE VMessAdr&+8,5            : ' VMess.ln_Type=NT_MESSAGE (5)
  87.     VMessAdr&=AllocMem&(64,0)   : ' Speicher fuer Message anfordern
  88.     FOR i=0 TO 64 
  89.       POKE VMessAdr&+i,0          : ' Speicher initialisieren
  90.     NEXT i   
  91.     POKEL VMessAdr&+14,RePort&    : ' ReplyPort in Message einbinden
  92.     POKEL VMessAdr&+24,VFontAdr&  : ' Startadresse Fontfile    
  93.   END IF
  94.      
  95. END SUB    
  96.  
  97. ' ***************************** Text ausgeben *****************************
  98.  
  99. SUB VektorTextOut(x&,y&,wi&,hi&,bspc&,text$,drmd&) STATIC
  100. SHARED VMessAdr&,MePort&,RePort&,FontBuff$,ErrVar&,VFontAdr&                          
  101.  
  102.   a$=text$+CHR$(0)                    : ' String terminieren
  103.   
  104.   POKEL VMessAdr&+20,WINDOW(8)        : ' Rastport von Ausgabefenster  
  105.   POKEL VMessAdr&+28,x&               : ' X-Koordinate
  106.   POKEL VMessAdr&+32,y&               : ' Y-Koordinate
  107.   POKEL VMessAdr&+36,wi&              : ' Fontbreite
  108.   POKEL VMessAdr&+40,hi&              : ' Fonthoehe
  109.   POKEL VMessAdr&+44,bspc&            : ' Zeichenabstand 
  110.   POKEL VMessAdr&+48,0               : ' Flagvariable auf NULL
  111.   POKEL VMessAdr&+52,SADD(a$)         : ' Startadresse Ausgabetext
  112.   POKEL VMessAdr&+56,LEN(a$)          : ' Laenge des Ausgabetextes
  113.   POKEL VMessAdr&+60,drmd&            : ' Zeichenmodus
  114.   
  115.   CALL PutMsg(MePort&,VMessAdr&)      : ' Message abschicken
  116.   CALL WaitPort(RePort&)              : ' Auf Antwort warten
  117.   h1&=GetMsg&(RePort&)                : ' Antwort abholen
  118.    
  119.   ErrVar&=PEEKL(h1&+48)               : ' Antwort auswerten
  120.   
  121. END SUB
  122.  
  123.